library(tswge)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
##
## Attaching package: 'tswge'
## The following object is masked from 'package:datasets':
##
## uspop
library(vars)
## Warning: package 'vars' was built under R version 4.3.1
## Loading required package: MASS
##
## Attaching package: 'MASS'
## The following object is masked from 'package:tswge':
##
## cement
## Loading required package: strucchange
## Warning: package 'strucchange' was built under R version 4.3.1
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Loading required package: sandwich
## Warning: package 'sandwich' was built under R version 4.3.1
## Loading required package: urca
## Loading required package: lmtest
##
## Attaching package: 'lmtest'
## The following object is masked from 'package:tswge':
##
## wages
library(nnfor)
## Loading required package: generics
##
## Attaching package: 'generics'
## The following object is masked from 'package:sandwich':
##
## estfun
## The following objects are masked from 'package:base':
##
## as.difftime, as.factor, as.ordered, intersect, is.element, setdiff,
## setequal, union
library(fpp)
## Warning: package 'fpp' was built under R version 4.3.1
## Loading required package: forecast
## Loading required package: fma
##
## Attaching package: 'fma'
## The following objects are masked from 'package:MASS':
##
## cement, housing, petrol
## The following object is masked from 'package:tswge':
##
## cement
## Loading required package: expsmooth
##
## Attaching package: 'expsmooth'
## The following object is masked from 'package:tswge':
##
## freight
## Loading required package: tseries
library(forecast)
library(backtest)
## Warning: package 'backtest' was built under R version 4.3.1
## Loading required package: grid
## Loading required package: lattice
library(quantmod)
## Loading required package: xts
## Loading required package: TTR
library(lubridate)
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(dplyr)
##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## ###############################################################################
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:xts':
##
## first, last
## The following object is masked from 'package:generics':
##
## explain
## The following object is masked from 'package:MASS':
##
## select
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(astsa)
##
## Attaching package: 'astsa'
## The following object is masked from 'package:fpp':
##
## oil
## The following objects are masked from 'package:fma':
##
## chicken, sales
## The following object is masked from 'package:forecast':
##
## gas
## The following object is masked from 'package:tswge':
##
## flu
library(GGally)
## Warning: package 'GGally' was built under R version 4.3.1
## Loading required package: ggplot2
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
##
## Attaching package: 'GGally'
## The following object is masked from 'package:fma':
##
## pigs
library(zoo)
Our clint Annaly Capital Management, Inc. is one of the largest mortgage real estate investment trusts. It is organized in Maryland with its principal office in New York City. The company borrows money, primarily via short term repurchase agreements, and reinvests the proceeds in asset-backed securities. CEO: David L. Finkelstein (Mar 2020–) has hired our firm to examine its past historical data and perform several time series forecasts to predict where the stock will open in the future based on current volumes. The data is contains the open, close, high, low price as well as the total volume recorded at every seven day period between the period 2013 - 2018.
df = read.csv("https://raw.githubusercontent.com/ReuvenDerner/MSDS-6373-Time-Series/master/Unit%205/NLY.csv")
# take a sample of 15 from the dataframe
nyse_sample = sample_n(df, 5)
knitr::kable(nyse_sample, "html")
| Date | Open | High | Low | Close | Adj.Close | Volume |
|---|---|---|---|---|---|---|
| 10/12/15 | 10.24 | 10.35 | 10.1 | 10.14 | 7.267362 | 33895700 |
| 8/24/15 | 9.87 | 10.29 | 9.72 | 10.17 | 7.07901 | 60620300 |
| 2/16/15 | 10.64 | 10.81 | 10.55 | 10.72 | 7.032185 | 23406000 |
| 8/8/16 | 11.09 | 11.29 | 11.02 | 11.08 | 8.702219 | 34829100 |
| 6/12/17 | 12.13 | 12.45 | 12.06 | 12.36 | 10.528988 | 40191800 |
The data has no missing values and no imputation is necessary, we can proceed with our analysis.
#reassign the dataframe
#df = TimeSeriesProject2018_2020
# Address the missing values in each column (NA as well as empty strings).
missing_df = as.data.frame(sapply(df, function(x) sum(is.na(x))))
colnames(missing_df) = c("variable missing")
knitr::kable(missing_df, "html")
| variable missing | |
|---|---|
| Date | 0 |
| Open | 0 |
| High | 0 |
| Low | 0 |
| Close | 0 |
| Adj.Close | 0 |
| Volume | 0 |
empty_string_df = as.data.frame(sapply(df, function(x) sum(x == "")))
colnames(empty_string_df) = c("variable empty")
knitr::kable(empty_string_df, "html")
| variable empty | |
|---|---|
| Date | 0 |
| Open | 0 |
| High | 0 |
| Low | 0 |
| Close | 0 |
| Adj.Close | 0 |
| Volume | 0 |
# Generate summary statistics
summary(df)
## Date Open High Low
## Length:263 Length:263 Length:263 Length:263
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
## Close Adj.Close Volume
## Length:263 Length:263 Length:263
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
We need to reclassify the data as numeric volumes
# Convert the Date column with the correct format
df$Date <- as.Date(df$Date, format = "%m/%d/%y")
# Convert columns to appropriate data types
df <- df %>%
mutate(Date = as.Date(Date), # Convert Date column to Date type
Open = as.numeric(Open), # Convert Open column to numeric type
High = as.numeric(High), # Convert High column to numeric type
Low = as.numeric(Low), # Convert Low column to numeric type
Close = as.numeric(Close), # Convert Close column to numeric type
Adj.Close = as.numeric(Adj.Close), # Convert Adj Close column to numeric type
Volume = as.integer(Volume)) # Convert Volume column to integer type
## Warning: There were 6 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `Open = as.numeric(Open)`.
## Caused by warning:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 5 remaining warnings.
summary(df)
## Date Open High Low
## Min. :2013-11-18 Min. : 8.97 Min. : 9.04 Min. : 8.25
## 1st Qu.:2015-02-19 1st Qu.:10.21 1st Qu.:10.36 1st Qu.:10.03
## Median :2016-05-23 Median :10.59 Median :10.74 Median :10.40
## Mean :2016-05-22 Mean :10.75 Mean :10.91 Mean :10.57
## 3rd Qu.:2017-08-24 3rd Qu.:11.31 3rd Qu.:11.49 3rd Qu.:11.15
## Max. :2018-11-23 Max. :12.61 Max. :12.73 Max. :12.32
## NA's :1 NA's :1 NA's :1
## Close Adj.Close Volume
## Min. : 8.96 Min. : 5.572 Min. : 4209958
## 1st Qu.:10.21 1st Qu.: 7.000 1st Qu.: 33175550
## Median :10.57 Median : 8.060 Median : 40010450
## Mean :10.75 Mean : 8.291 Mean : 43003015
## 3rd Qu.:11.31 3rd Qu.: 9.854 3rd Qu.: 49882100
## Max. :12.60 Max. :10.994 Max. :197494800
## NA's :1 NA's :1 NA's :1
NA were introduced by the mutation of the data, we will just remove the record where that occurs
df.adj = na.omit(df)
ggpairs(df.adj)
The adj.Close & Open Price is significantly correlated to all other variables in the dataset, particular with one another at 0.91 positive correlation.
## $xbar
## [1] 10.74882
##
## $autplt
## [1] 1.0000000 0.9558782 0.9140551 0.8798739 0.8356028 0.7947093 0.7579893
## [8] 0.7244069 0.6985809 0.6709464 0.6492885 0.6188956 0.5877319 0.5641738
## [15] 0.5247691 0.4840137 0.4481811 0.4072040 0.3655794 0.3241797 0.2839057
## [22] 0.2530625 0.2206851 0.2007074 0.1831944 0.1594867
##
## $freq
## [1] 0.003816794 0.007633588 0.011450382 0.015267176 0.019083969 0.022900763
## [7] 0.026717557 0.030534351 0.034351145 0.038167939 0.041984733 0.045801527
## [13] 0.049618321 0.053435115 0.057251908 0.061068702 0.064885496 0.068702290
## [19] 0.072519084 0.076335878 0.080152672 0.083969466 0.087786260 0.091603053
## [25] 0.095419847 0.099236641 0.103053435 0.106870229 0.110687023 0.114503817
## [31] 0.118320611 0.122137405 0.125954198 0.129770992 0.133587786 0.137404580
## [37] 0.141221374 0.145038168 0.148854962 0.152671756 0.156488550 0.160305344
## [43] 0.164122137 0.167938931 0.171755725 0.175572519 0.179389313 0.183206107
## [49] 0.187022901 0.190839695 0.194656489 0.198473282 0.202290076 0.206106870
## [55] 0.209923664 0.213740458 0.217557252 0.221374046 0.225190840 0.229007634
## [61] 0.232824427 0.236641221 0.240458015 0.244274809 0.248091603 0.251908397
## [67] 0.255725191 0.259541985 0.263358779 0.267175573 0.270992366 0.274809160
## [73] 0.278625954 0.282442748 0.286259542 0.290076336 0.293893130 0.297709924
## [79] 0.301526718 0.305343511 0.309160305 0.312977099 0.316793893 0.320610687
## [85] 0.324427481 0.328244275 0.332061069 0.335877863 0.339694656 0.343511450
## [91] 0.347328244 0.351145038 0.354961832 0.358778626 0.362595420 0.366412214
## [97] 0.370229008 0.374045802 0.377862595 0.381679389 0.385496183 0.389312977
## [103] 0.393129771 0.396946565 0.400763359 0.404580153 0.408396947 0.412213740
## [109] 0.416030534 0.419847328 0.423664122 0.427480916 0.431297710 0.435114504
## [115] 0.438931298 0.442748092 0.446564885 0.450381679 0.454198473 0.458015267
## [121] 0.461832061 0.465648855 0.469465649 0.473282443 0.477099237 0.480916031
## [127] 0.484732824 0.488549618 0.492366412 0.496183206 0.500000000
##
## $dbz
## [1] 12.3443460 12.1228799 11.7532303 11.2347782 10.5671017 9.7505942
## [7] 8.7875642 7.6841519 6.4535662 5.1212070 3.7316979 2.3555051
## [13] 1.0875438 0.0259685 -0.7692079 -1.3080599 -1.6600405 -1.9129555
## [19] -2.1400160 -2.3896794 -2.6893036 -3.0518240 -3.4806765 -3.9722487
## [25] -4.5166737 -5.0981771 -5.6962174 -6.2883607 -6.8549197 -7.3838797
## [31] -7.8735208 -8.3307927 -8.7658815 -9.1855952 -9.5886185 -9.9647212
## [37] -10.2985759 -10.5770289 -10.7965340 -10.9665692 -11.1069589 -11.2408671
## [43] -11.3872726 -11.5557692 -11.7445346 -11.9411914 -12.1261441 -12.2778885
## [49] -12.3791413 -12.4217684 -12.4085394 -12.3512550 -12.2667084 -12.1726483
## [55] -12.0851369 -12.0174958 -11.9802959 -11.9817327 -12.0279214 -12.1228943
## [61] -12.2682448 -12.4624343 -12.6998127 -12.9694599 -13.2541297 -13.5299047
## [67] -13.7675699 -13.9367607 -14.0129350 -13.9850215 -13.8598244 -13.6604049
## [73] -13.4194473 -13.1714081 -12.9467196 -12.7690074 -12.6545893 -12.6131227
## [79] -12.6485770 -12.7601240 -12.9428284 -13.1881519 -13.4843191 -13.8165558
## [85] -14.1671642 -14.5154049 -14.8373456 -15.1062620 -15.2946569 -15.3788765
## [91] -15.3458703 -15.1992467 -14.9607755 -14.6658854 -14.3556431 -14.0692508
## [97] -13.8394649 -13.6909797 -13.6406322 -13.6982675 -13.8675239 -14.1461975
## [103] -14.5261126 -14.9926349 -15.5242113 -16.0926253 -16.6648862 -17.2073897
## [109] -17.6917666 -18.1000522 -18.4261423 -18.6724033 -18.8435710 -18.9417729
## [115] -18.9654783 -18.9126401 -18.7858615 -18.5962859 -18.3638336 -18.1138551
## [121] -17.8722552 -17.6612698 -17.4968983 -17.3878545 -17.3354561 -17.3339992
## [127] -17.3715141 -17.4311300 -17.4934183 -17.5398684 -17.5570033
## $freq
## [1] 0.003816794 0.007633588 0.011450382 0.015267176 0.019083969 0.022900763
## [7] 0.026717557 0.030534351 0.034351145 0.038167939 0.041984733 0.045801527
## [13] 0.049618321 0.053435115 0.057251908 0.061068702 0.064885496 0.068702290
## [19] 0.072519084 0.076335878 0.080152672 0.083969466 0.087786260 0.091603053
## [25] 0.095419847 0.099236641 0.103053435 0.106870229 0.110687023 0.114503817
## [31] 0.118320611 0.122137405 0.125954198 0.129770992 0.133587786 0.137404580
## [37] 0.141221374 0.145038168 0.148854962 0.152671756 0.156488550 0.160305344
## [43] 0.164122137 0.167938931 0.171755725 0.175572519 0.179389313 0.183206107
## [49] 0.187022901 0.190839695 0.194656489 0.198473282 0.202290076 0.206106870
## [55] 0.209923664 0.213740458 0.217557252 0.221374046 0.225190840 0.229007634
## [61] 0.232824427 0.236641221 0.240458015 0.244274809 0.248091603 0.251908397
## [67] 0.255725191 0.259541985 0.263358779 0.267175573 0.270992366 0.274809160
## [73] 0.278625954 0.282442748 0.286259542 0.290076336 0.293893130 0.297709924
## [79] 0.301526718 0.305343511 0.309160305 0.312977099 0.316793893 0.320610687
## [85] 0.324427481 0.328244275 0.332061069 0.335877863 0.339694656 0.343511450
## [91] 0.347328244 0.351145038 0.354961832 0.358778626 0.362595420 0.366412214
## [97] 0.370229008 0.374045802 0.377862595 0.381679389 0.385496183 0.389312977
## [103] 0.393129771 0.396946565 0.400763359 0.404580153 0.408396947 0.412213740
## [109] 0.416030534 0.419847328 0.423664122 0.427480916 0.431297710 0.435114504
## [115] 0.438931298 0.442748092 0.446564885 0.450381679 0.454198473 0.458015267
## [121] 0.461832061 0.465648855 0.469465649 0.473282443 0.477099237 0.480916031
## [127] 0.484732824 0.488549618 0.492366412 0.496183206 0.500000000
##
## $pzgram
## [1] 12.3443460 12.1228799 11.7532303 11.2347782 10.5671017 9.7505942
## [7] 8.7875642 7.6841519 6.4535662 5.1212070 3.7316979 2.3555051
## [13] 1.0875438 0.0259685 -0.7692079 -1.3080599 -1.6600405 -1.9129555
## [19] -2.1400160 -2.3896794 -2.6893036 -3.0518240 -3.4806765 -3.9722487
## [25] -4.5166737 -5.0981771 -5.6962174 -6.2883607 -6.8549197 -7.3838797
## [31] -7.8735208 -8.3307927 -8.7658815 -9.1855952 -9.5886185 -9.9647212
## [37] -10.2985759 -10.5770289 -10.7965340 -10.9665692 -11.1069589 -11.2408671
## [43] -11.3872726 -11.5557692 -11.7445346 -11.9411914 -12.1261441 -12.2778885
## [49] -12.3791413 -12.4217684 -12.4085394 -12.3512550 -12.2667084 -12.1726483
## [55] -12.0851369 -12.0174958 -11.9802959 -11.9817327 -12.0279214 -12.1228943
## [61] -12.2682448 -12.4624343 -12.6998127 -12.9694599 -13.2541297 -13.5299047
## [67] -13.7675699 -13.9367607 -14.0129350 -13.9850215 -13.8598244 -13.6604049
## [73] -13.4194473 -13.1714081 -12.9467196 -12.7690074 -12.6545893 -12.6131227
## [79] -12.6485770 -12.7601240 -12.9428284 -13.1881519 -13.4843191 -13.8165558
## [85] -14.1671642 -14.5154049 -14.8373456 -15.1062620 -15.2946569 -15.3788765
## [91] -15.3458703 -15.1992467 -14.9607755 -14.6658854 -14.3556431 -14.0692508
## [97] -13.8394649 -13.6909797 -13.6406322 -13.6982675 -13.8675239 -14.1461975
## [103] -14.5261126 -14.9926349 -15.5242113 -16.0926253 -16.6648862 -17.2073897
## [109] -17.6917666 -18.1000522 -18.4261423 -18.6724033 -18.8435710 -18.9417729
## [115] -18.9654783 -18.9126401 -18.7858615 -18.5962859 -18.3638336 -18.1138551
## [121] -17.8722552 -17.6612698 -17.4968983 -17.3878545 -17.3354561 -17.3339992
## [127] -17.3715141 -17.4311300 -17.4934183 -17.5398684 -17.5570033
The ACF plots shows a slowly dampening autocorrelation, along with the
spectral density, there may be some frequency with the five peaks in the
spectral density, however there is strong evidence of wandering behavior
and stationary.
#First put the object into a ts object
ts_nly_open = ts(df.adj$Open, frequency = 1)
aic5.wge(ts_nly_open, p = 0:10, q = 0:10) #picks a 6:6 model, lets difference the data first
## ---------WORKING... PLEASE WAIT...
##
##
## Error in aic calculation at 7 7
## Five Smallest Values of aic
## p q aic
## 6 6 -3.078345
## 8 7 -3.050791
## 8 2 -3.048955
## 5 2 -3.045016
## 9 2 -3.041199
diff_ts = artrans.wge(ts_nly_open, 1) # we get an acf plot at lag 1 as opposed to lag 0, lets difference the differences data
diff_two_ts = artrans.wge(diff_ts,1) # the acf lag has another pronounced at lag 2, however the first differences data may be better suited. We'll proceed with the first differenced data set.
aic5.wge(diff_ts, p = 0:10, q = 0:10, type = "aic") # at iteration 80, AIC picks AR(7)MA(2) model
## ---------WORKING... PLEASE WAIT...
##
##
## Five Smallest Values of aic
## p q aic
## 7 2 -3.036156
## 4 2 -3.031027
## 7 3 -3.017738
## 2 9 -3.015115
## 3 0 -3.014866
aic5.wge(diff_ts, p= 0:10, q=0:10, type ="bic") # at iteration 75, BIC picks AR(0)MA(0) model
## ---------WORKING... PLEASE WAIT...
##
##
## Five Smallest Values of bic
## p q bic
## 0 0 -2.996849
## 0 1 -2.976414
## 1 0 -2.976223
## 2 0 -2.967971
## 0 2 -2.967646
Noting that the BIC choose a AR0MA0 model, this tells us that we have likely high degrees of wandering even after differences the data, we’ll model both, but give the bic a straight seasonal component
#AIC Model AR(8)MA(9) model
aic_est = est.arma.wge(diff_ts, p = 7, q = 2)
##
##
## Coefficients of AR polynomial:
## -1.4236 -1.0081 -0.0554 0.0271 0.0002 -0.1162 -0.1176
##
## AR Factor Table
## Factor Roots Abs Recip System Freq
## 1+1.4581B+0.9751B^2 -0.7476+-0.6830i 0.9875 0.3822
## 1+0.3322B+0.4935B^2 -0.3365+-1.3831i 0.7025 0.2880
## 1+0.6515B -1.5349 0.6515 0.5000
## 1-1.0182B+0.3750B^2 1.3575+-0.9075i 0.6124 0.0938
##
##
##
##
## Coefficients of MA polynomial:
## -1.4456 -0.9218
##
## MA FACTOR TABLE
## Factor Roots Abs Recip System Freq
## 1+1.4456B+0.9218B^2 -0.7841+-0.6856i 0.9601 0.3857
##
##
#BIC Model AR(6)MA(8) model
bic_est = est.arma.wge(diff_ts, p = 0, q = 0)
# Create a data frame with all four predictors (Open, Close, High, Low columns)
tnlyx <- data.frame(Open = ts(df.adj$Open), Close = ts(df.adj$Close), High = ts(df.adj$High), Low = ts(df.adj$Low), frequency = 1)
# Remove rows with NA values from the entire data frame
df_clean <- tnlyx[complete.cases(tnlyx), ]
# Apply VARSelect to select the optimal lag order
var_order <- VARselect(df_clean, lag.max = 10, type = "both")
# Get the optimal lag order selected by AIC, HQIC, and SC
optimal_lag <- var_order$selection
optimal_lag
## AIC(n) HQ(n) SC(n) FPE(n)
## 1 1 1 1
# Create a data frame with all four variables (Open, Close, High, Low columns)
data <- data.frame(Open = df.adj$Open, Close = df.adj$Close, High = df.adj$High, Low = df.adj$Low)
# Set the lag order you want to use
lag_order <- 1
# Lag the other three variables (Close, High, Low) in the data frame
lagged_data <- data %>% mutate_at(vars(-Open), lag, n = lag_order)
# Remove rows with NA values from the lagged_data
lagged_data <- na.omit(lagged_data)
# Fit the VAR model using the lagged_data
var_model <- VAR(lagged_data, p = lag_order, type = "both")
var_model
##
## VAR Estimation Results:
## =======================
##
## Estimated coefficients for equation Open:
## =========================================
## Call:
## Open = Open.l1 + Close.l1 + High.l1 + Low.l1 + const + trend
##
## Open.l1 Close.l1 High.l1 Low.l1 const
## 0.9267299491 -0.0725082332 0.0518762053 0.0563128408 0.4193964134
## trend
## -0.0001087287
##
##
## Estimated coefficients for equation Close:
## ==========================================
## Call:
## Close = Open.l1 + Close.l1 + High.l1 + Low.l1 + const + trend
##
## Open.l1 Close.l1 High.l1 Low.l1 const
## 0.8957877004 -0.0129277781 0.0588175712 0.0183600471 0.4523733878
## trend
## -0.0002184793
##
##
## Estimated coefficients for equation High:
## =========================================
## Call:
## High = Open.l1 + Close.l1 + High.l1 + Low.l1 + const + trend
##
## Open.l1 Close.l1 High.l1 Low.l1 const trend
## 0.940172100 -0.032746836 0.147284505 -0.074003928 0.356700949 -0.000180586
##
##
## Estimated coefficients for equation Low:
## ========================================
## Call:
## Low = Open.l1 + Close.l1 + High.l1 + Low.l1 + const + trend
##
## Open.l1 Close.l1 High.l1 Low.l1 const
## 1.0683737037 -0.1966631921 -0.0835850892 0.1845078280 0.1740256553
## trend
## -0.0000982939
summary(var_model)
##
## VAR Estimation Results:
## =========================
## Endogenous variables: Open, Close, High, Low
## Deterministic variables: both
## Sample size: 260
## Log Likelihood: 970.857
## Roots of the characteristic polynomial:
## 0.9642 0.2653 0.05207 0.03593
## Call:
## VAR(y = lagged_data, p = lag_order, type = "both")
##
##
## Estimation results for equation Open:
## =====================================
## Open = Open.l1 + Close.l1 + High.l1 + Low.l1 + const + trend
##
## Estimate Std. Error t value Pr(>|t|)
## Open.l1 0.9267299 0.2720113 3.407 0.000764 ***
## Close.l1 -0.0725082 0.3009176 -0.241 0.809783
## High.l1 0.0518762 0.1076667 0.482 0.630347
## Low.l1 0.0563128 0.1215762 0.463 0.643625
## const 0.4193964 0.2000355 2.097 0.037017 *
## trend -0.0001087 0.0001869 -0.582 0.561207
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 0.2214 on 254 degrees of freedom
## Multiple R-Squared: 0.9195, Adjusted R-squared: 0.9179
## F-statistic: 579.9 on 5 and 254 DF, p-value: < 2.2e-16
##
##
## Estimation results for equation Close:
## ======================================
## Close = Open.l1 + Close.l1 + High.l1 + Low.l1 + const + trend
##
## Estimate Std. Error t value Pr(>|t|)
## Open.l1 0.8957877 0.2612343 3.429 0.000707 ***
## Close.l1 -0.0129278 0.2889954 -0.045 0.964355
## High.l1 0.0588176 0.1034010 0.569 0.569974
## Low.l1 0.0183600 0.1167594 0.157 0.875175
## const 0.4523734 0.1921102 2.355 0.019296 *
## trend -0.0002185 0.0001795 -1.217 0.224609
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 0.2127 on 254 degrees of freedom
## Multiple R-Squared: 0.9249, Adjusted R-squared: 0.9234
## F-statistic: 625.2 on 5 and 254 DF, p-value: < 2.2e-16
##
##
## Estimation results for equation High:
## =====================================
## High = Open.l1 + Close.l1 + High.l1 + Low.l1 + const + trend
##
## Estimate Std. Error t value Pr(>|t|)
## Open.l1 0.9401721 0.1534984 6.125 3.43e-09 ***
## Close.l1 -0.0327468 0.1698105 -0.193 0.84724
## High.l1 0.1472845 0.0607573 2.424 0.01604 *
## Low.l1 -0.0740039 0.0686065 -1.079 0.28176
## const 0.3567009 0.1128818 3.160 0.00177 **
## trend -0.0001806 0.0001055 -1.712 0.08804 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 0.125 on 254 degrees of freedom
## Multiple R-Squared: 0.9738, Adjusted R-squared: 0.9733
## F-statistic: 1889 on 5 and 254 DF, p-value: < 2.2e-16
##
##
## Estimation results for equation Low:
## ====================================
## Low = Open.l1 + Close.l1 + High.l1 + Low.l1 + const + trend
##
## Estimate Std. Error t value Pr(>|t|)
## Open.l1 1.068e+00 2.020e-01 5.289 2.65e-07 ***
## Close.l1 -1.967e-01 2.234e-01 -0.880 0.380
## High.l1 -8.359e-02 7.995e-02 -1.045 0.297
## Low.l1 1.845e-01 9.028e-02 2.044 0.042 *
## const 1.740e-01 1.485e-01 1.172 0.242
## trend -9.829e-05 1.388e-04 -0.708 0.479
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 0.1644 on 254 degrees of freedom
## Multiple R-Squared: 0.9551, Adjusted R-squared: 0.9542
## F-statistic: 1080 on 5 and 254 DF, p-value: < 2.2e-16
##
##
##
## Covariance matrix of residuals:
## Open Close High Low
## Open 0.04903 0.04583 0.02054 0.02844
## Close 0.04583 0.04522 0.01999 0.02817
## High 0.02054 0.01999 0.01561 0.01157
## Low 0.02844 0.02817 0.01157 0.02703
##
## Correlation matrix of residuals:
## Open Close High Low
## Open 1.0000 0.9733 0.7423 0.7811
## Close 0.9733 1.0000 0.7525 0.8058
## High 0.7423 0.7525 1.0000 0.5631
## Low 0.7811 0.8058 0.5631 1.0000
#xtract the estimated coefficients from the var_model list
coefficients <- coef(var_model)[['Open']] # Replace 'Open' with the desired variable
# Extract the estimated coefficients and convert to numeric format
coefficients <- as.numeric(coefficients)
# Extract the standard errors of the coefficients
standard_errors <- sqrt(diag(vcov(var_model)))
# Calculate the confidence intervals (95% by default)
lower_ci <- coefficients - 1.96 * standard_errors
upper_ci <- coefficients + 1.96 * standard_errors
# Create a data frame to store the results
confidence_intervals <- data.frame(
Coefficients = coefficients,
Lower_CI = lower_ci,
Upper_CI = upper_ci
)
print(confidence_intervals)
## Coefficients Lower_CI Upper_CI
## Open:(Intercept) 0.9267299491 0.5346604061 1.3187994922
## Open:Open.l1 -0.0725082332 -0.6056503098 0.4606338434
## Open:Close.l1 0.0518762053 -0.5379222888 0.6416746994
## Open:High.l1 0.0563128408 -0.1547139621 0.2673396437
## Open:Low.l1 0.4193964134 0.1811070801 0.6576857468
## Open:trend -0.0001087287 -0.0004750103 0.0002575530
## Close:(Intercept) 0.2720112636 -0.1045246403 0.6485471674
## Close:Open.l1 0.3009175990 -0.2111016007 0.8129367988
## Close:Close.l1 0.1076667362 -0.4587641764 0.6740976488
## Close:High.l1 0.1215761905 -0.0810898145 0.3242421955
## Close:Low.l1 0.2000354811 -0.0288129237 0.4288838859
## Close:trend 0.0001868784 -0.0001648913 0.0005386481
## High:(Intercept) 3.4069543185 3.1857059705 3.6282026666
## High:Open.l1 -0.2409571039 -0.5418139438 0.0598997360
## High:Close.l1 0.4818220291 0.1489934663 0.8146505919
## High:High.l1 0.4631897130 0.3441054016 0.5822740244
## High:Low.l1 2.0966101166 1.9621413156 2.2310789175
## High:trend -0.5818151923 -0.5820218883 -0.5816084963
## Low:(Intercept) 0.0007635957 -0.2903701649 0.2918973564
## Low:Open.l1 0.8097827491 0.4138946714 1.2056708268
## Low:Close.l1 0.6303472613 0.1923885964 1.0683059262
## Low:High.l1 0.6436250086 0.4869256989 0.8003243182
## Low:Low.l1 0.0370173831 -0.1399258939 0.2139606600
## Low:trend 0.5612071811 0.5609351963 0.5614791659
Estimated coefficients for equation Open:
** A one-unit increase in the lagged ‘Open’ variable (Open[t-1]) leads to a 0.9267 increase in the current ‘Open’ variable (Open[t]).
** A one-unit increase in the lagged ‘Close’ variable (Close[t-1]) leads to a -0.0725 decrease in the current ‘Open’ variable (Open[t]).
**A one-unit increase in the lagged ‘High’ variable (High[t-1]) leads to a 0.0519 increase in the current ‘Open’ variable (Open[t]).
**A one-unit increase in the lagged ‘Low’ variable (Low[t-1]) leads to a 0.0563 increase in the current ‘Open’ variable (Open[t]).
The constant term (intercept) and trend do not have lagged values as they are constant across time.
The equation’s multiple R-squared and adjusted R-squared are 0.9195 and 0.9179, respectively, indicating a good fit.
The F-statistic and its p-value suggest that the overall equation is significant.
# Fit the VAR model using the lagged_data
VAR_SM2 = VAR(lagged_data,lag.max = 5, type = "both")
pred.short = predict(VAR_SM2,n.ahead = 12)
pred.short$fcst$Open[,1]
## [1] 9.970557 9.984902 9.998284 10.010942 10.023007 10.034528 10.045531
## [8] 10.056037 10.066064 10.075630 10.084750 10.093442
plot(data$Open, type = "l")
lines(seq(251,262,1),pred.short$fcst$Open[,1],col = "red")
var_ase_short_horizon = mean((data$Open[251:262] - pred.short$fcst$Open[,1])^2)
var_ase_short_horizon
## [1] 0.06697107
# Fit the VAR model using the lagged_data
VAR_SM2 = VAR(lagged_data,lag.max = 15, type = "both")
pred.long = predict(VAR_SM2,n.ahead = 20)
pred.long$fcst$Open[,1]
## [1] 9.970557 9.984902 9.998284 10.010942 10.023007 10.034528 10.045531
## [8] 10.056037 10.066064 10.075630 10.084750 10.093442 10.101720 10.109599
## [15] 10.117093 10.124217 10.130983 10.137405 10.143494 10.149263
plot(data$Open, type = "l")
lines(seq(243,262,1),pred.long$fcst$Open[,1],col = "red")
var_ase_long_horizon = mean((data$Open[243:262] - pred.long$fcst$Open[,1])^2)
var_ase_long_horizon
## [1] 0.1551258
#MLP
NLYsmall = df.adj[1:250,]
NLYsmallDF = data.frame(Close = ts(NLYsmall$Close), High = ts(NLYsmall$High), Low = ts(NLYsmall$Low))
#Using forecast Open
fit.mlp.Close = mlp(ts(NLYsmallDF$Close),reps = 50, comb = "mean")
fit.mlp.High = mlp(ts(NLYsmallDF$High),reps = 50, comb = "mean")
fit.mlp.Low = mlp(ts(NLYsmallDF$Low),reps = 50, comb = "mean")
#Forecast the explainble features
fore.mlp.Close = forecast(fit.mlp.Close, h = 12)
fore.mlp.High = forecast(fit.mlp.High, h = 12)
fore.mlp.Low = forecast(fit.mlp.Low, h = 12)
#plot(fore.mlp.Open) # plot the forecasts
NLYsmallDF_fore = data.frame(Close = ts(fore.mlp.Close$mean), High = ts(fore.mlp.High$mean), Low = ts(fore.mlp.Low$mean))
NLYsmallDF_fore
## Close High Low
## t+1 10.50728 10.77419 10.43726
## t+2 10.52016 10.75849 10.43459
## t+3 10.50540 10.75478 10.43200
## t+4 10.50505 10.75392 10.42950
## t+5 10.51018 10.74902 10.42709
## t+6 10.50933 10.74379 10.42477
## t+7 10.50904 10.73909 10.42255
## t+8 10.50782 10.73448 10.42041
## t+9 10.50946 10.73009 10.41837
## t+10 10.50872 10.72570 10.41641
## t+11 10.50855 10.72108 10.41453
## t+12 10.51085 10.71652 10.41273
fit.mlp = mlp(ts(NLYsmall$Open),reps = 50,comb = "mean",hd.auto.type = "cv",xreg = NLYsmallDF) #sensitive to initial values, first 50 iterations
fit.mlp
## MLP fit with 6 hidden nodes and 50 repetitions.
## Univariate lags: (2,3)
## 3 regressors included.
## - Regressor 1 lags: (1,2)
## - Regressor 2 lags: (3)
## - Regressor 3 lags: (2)
## Forecast combined using the mean operator.
## MSE: 0.0025.
plot(fit.mlp)
NLYDF = data.frame(Close = ts(c(NLYsmallDF$Close,NLYsmallDF_fore$Close)), High = ts(c(NLYsmallDF$High, NLYsmallDF_fore$High)),Low = ts(c(NLYsmallDF$Low, NLYsmallDF_fore$Low)))
fore.mlp.short = forecast(fit.mlp, h = 12, xreg = NLYDF)
plot(fore.mlp.short)
plot(df.adj$Open, type = "l")
lines(seq(251,262,1),fore.mlp.short$mean,col = "blue")
MLP_SH_ASE = mean((df.adj$Open[251:262] - fore.mlp.short$mean)^2)
print(paste("ASE Score:", MLP_SH_ASE))
## [1] "ASE Score: 0.242792631669759"
#MLP
NLYLong = df.adj[1:243,]
NLYLongDF = data.frame(Close = ts(NLYLong$Close), High = ts(NLYLong$High), Low = ts(NLYLong$Low))
#Using forecast Open
fit.mlp.Close = mlp(ts(NLYLongDF$Close), hd.auto.type = "cv",reps = 50, comb = "mean")
fit.mlp.High = mlp(ts(NLYLongDF$High), hd.auto.type = "cv",reps = 50, comb = "mean")
fit.mlp.Low = mlp(ts(NLYLongDF$Low), hd.auto.type = "cv",reps = 50, comb = "mean")
#Forecast the explainable features
fore.mlp.Close = forecast(fit.mlp.Close, h = 20)
fore.mlp.High = forecast(fit.mlp.High, h = 20)
fore.mlp.Low = forecast(fit.mlp.Low, h = 20)
#plot(fore.mlp.Open) # plot the forecasts
NLYLongDF_fore = data.frame(Close = ts(fore.mlp.Close$mean), High = ts(fore.mlp.High$mean), Low = ts(fore.mlp.Low$mean))
NLYLongDF_fore
## Close High Low
## t+1 10.52238 10.45903 10.32275
## t+2 10.50331 10.44864 10.31538
## t+3 10.50583 10.43805 10.30789
## t+4 10.50314 10.42511 10.30028
## t+5 10.49505 10.41565 10.29256
## t+6 10.48985 10.40753 10.28473
## t+7 10.48412 10.39936 10.27681
## t+8 10.47770 10.39176 10.26881
## t+9 10.47170 10.38478 10.26072
## t+10 10.46567 10.37819 10.25257
## t+11 10.45960 10.37198 10.24435
## t+12 10.45362 10.36619 10.23608
## t+13 10.44770 10.36078 10.22777
## t+14 10.44182 10.35572 10.21943
## t+15 10.43602 10.35101 10.21107
## t+16 10.43029 10.34662 10.20270
## t+17 10.42462 10.34254 10.19434
## t+18 10.41904 10.33875 10.18599
## t+19 10.41354 10.33524 10.17767
## t+20 10.40812 10.33199 10.16939
fit.mlp = mlp(ts(NLYLong$Open),reps = 50,comb = "mean",hd.auto.type = "cv",xreg = NLYLongDF) #sensitive to initial values, first 50 iterations
fit.mlp
## MLP fit with 6 hidden nodes and 50 repetitions.
## Univariate lags: (1,2,3,4)
## 1 regressor included.
## - Regressor 1 lags: (1)
## Forecast combined using the mean operator.
## MSE: 0.0027.
plot(fit.mlp)
NLYDF.Long = data.frame(Close = ts(c(NLYLongDF$Close,NLYLongDF_fore$Close)), High = ts(c(NLYLongDF$High, NLYLongDF_fore$High)),Low = ts(c(NLYLongDF$Low, NLYLongDF_fore$Low)))
fore.mlp.long = forecast(fit.mlp, h = 20, xreg = NLYDF.Long)
plot(fore.mlp.long)
plot(df.adj$Open, type = "l")
lines(seq(243,262,1),fore.mlp.long$mean,col = "blue")
MLP_LH_ASE = mean((df.adj$Open[243:262] - fore.mlp.long$mean)^2)
print(paste("ASE Score:", MLP_LH_ASE))
## [1] "ASE Score: 0.109881262899984"
sh_ensemble = (fore.mlp.short$mean + pred.short$fcst$Open[,1])/2
plot(df.adj$Open, type = "l")
lines(seq(251,262,1),sh_ensemble,col = "green")
lh_ensemble = (fore.mlp.long$mean + pred.long$fcst$Open[,1])/2
plot(df.adj$Open, type = "l")
lines(seq(243,262,1),lh_ensemble,col = "green")
ensemble_SH_ASE = mean((ts_nly_open[251:262] - sh_ensemble)^2)
ensemble_SH_ASE
## [1] 0.09773999
ensemble_LH_ASE = mean((ts_nly_open[243:262] - lh_ensemble)^2)
ensemble_LH_ASE
## [1] 0.09296973
The ensemble does perform better than the Univariate and the MLP models by themselves. It may be worth noting to perform an ensemble model on an ongoing basis.
### Univariate ASEs ###
aic_uni_sh = ase_aic_univariate.short # 0.3818423
aic_uni_lh = ase_aic_univariate.long #
bic_uni_sh = ase_bic_univariate.short # [1] 0.3891917
bic_uni_lh = ase_bic_univariate.long #
roll_win_ase_short = 0.459
roll_win_ase_long = 0.588
# roll.win.rmse.wge(ts_nly_open, horizon = 12, d = 1 )
# [1] "The Summary Statistics for the Rolling Window RMSE Are:"
# Min. 1st Qu. Median Mean 3rd Qu. Max.
# 0.08954 0.27891 0.40805 0.45852 0.60149 1.49417
# [1] "The Rolling Window RMSE is: 0.459"
### Multivariate Long Short Horizon ###
var_lh = var_ase_long_horizon
var_sh = var_ase_short_horizon
mlp_lh = MLP_LH_ASE
mlp_sh = MLP_SH_ASE
comb_sh = ensemble_SH_ASE
comb_lh = ensemble_LH_ASE
# Create a data frame to store the model names and their ASE scores
model_ase_df <- data.frame(Model =
c("AIC Univariate Short Model", "AIC Univariate Long Model", "BIC Univariate Short Model", "BIC Univariate Long Model", "Rolling Window RMSE Short Model", "Rolling Window RMSE Long Model", "VAR Short Horizon", "MLP Short Horizon", "Ensemble Model Short Horizon","VAR Long Horizon", "MLP Long Horizon", "Ensemble Model Long Horizon"),
ASE = c(aic_uni_sh, aic_uni_lh, bic_uni_sh, bic_uni_lh, roll_win_ase_short, roll_win_ase_long, var_sh, mlp_sh, comb_sh, var_lh, mlp_lh, comb_lh))
# Round the ASE scores to 4 decimal places
model_ase_df$ASE <- round(model_ase_df$ASE, 4)
#Add a new Column "Rank" to the DF which contains there rank order
model_ase_df$Rank <- rank(model_ase_df$ASE)
model_ase_df <- model_ase_df [order(model_ase_df$Rank), ]
# Display the data frame in an output box
print(model_ase_df)
## Model ASE Rank
## 7 VAR Short Horizon 0.0670 1
## 12 Ensemble Model Long Horizon 0.0930 2
## 9 Ensemble Model Short Horizon 0.0977 3
## 11 MLP Long Horizon 0.1099 4
## 10 VAR Long Horizon 0.1551 5
## 4 BIC Univariate Long Model 0.1621 6
## 2 AIC Univariate Long Model 0.1671 7
## 8 MLP Short Horizon 0.2428 8
## 1 AIC Univariate Short Model 0.3818 9
## 3 BIC Univariate Short Model 0.3892 10
## 5 Rolling Window RMSE Short Model 0.4590 11
## 6 Rolling Window RMSE Long Model 0.5880 12
# Fit the univariate forecasts AIC & BIC
# AIC Model Forecast
aic_fore.short = fore.arima.wge(ts_nly_open, phi = aic_est$phi, theta = aic_est$theta, d=1,n.ahead = 12, lastn = T, limits = T)
## y.arma -0.02 -0.48 0.24 0.17 -0.29 0.21 0.22 -0.04 0.32 0.26 0.14 -0.14 -0.02 0.42 -0.2 0.36 0.09 -0.52 0.09 0.43 -0.19 0.28 0.03 0.05 0.08 0.09 0.02 -0.17 0 0.03 -0.22 -0.37 0.08 0.1 0.08 -0.08 0.19 0.33 0.02 0.12 -0.1 -0.43 -0.04 -0.44 -0.11 0.41 -0.01 0.16 0.04 -0.15 0.16 0.11 0.01 -0.07 -0.03 -0.08 -0.3 -0.06 -0.18 -0.18 -0.07 -0.01 -0.04 0.14 0.08 -0.1 -0.19 0.04 0.27 -0.21 -0.08 -0.06 -0.09 -0.07 -0.13 -0.03 0.08 0.1 0.2 -0.52 -0.01 0.01 -0.67 0.06 0.18 0.28 -0.22 0.4 0.13 0.29 -0.51 0.3 0.03 -0.09 0.27 -0.29 -0.09 0.24 -0.1 0.07 -0.26 -0.48 0.1 -0.02 0.12 -0.19 -0.27 0.31 0.24 -0.44 0.06 -0.41 0.06 0.46 0.22 0.06 0.2 0.23 0.1 -0.01 0.12 0.04 -0.12 -0.17 0.24 -0.17 0.2 0.45 0.15 -0.07 -0.34 0.21 -0.03 -0.2 0.31 0.05 -0.17 -0.14 0.25 0.08 0.11 -0.03 -0.13 -0.13 0.1 -0.49 0.06 0.32 -0.32 -0.42 0.1 -0.04 0.17 0.07 -0.25 -0.07 0.08 -0.13 0.49 -0.25 0.11 -0.31 0.24 -0.11 0.01 0.09 0.06 0.24 0.3 0.23 -0.12 0 0.06 0.12 -0.03 0.19 0.33 0.15 0.06 -0.26 -0.28 0.23 0.28 0.21 0.11 0.26 0.22 -0.56 0.02 0.26 -0.42 0.06 0.04 0.3 0.06 0.01 0.09 -0.07 -0.05 0.12 -0.26 -0.06 0.09 0.02 -0.67 -0.39 0.01 0.29 0.29 0.06 0.12 0.29 -0.2 -0.17 -0.32 -0.26 -0.08 -0.35 -0.56 -0.09 0.38 -0.18 -0.33 0.25 0.27 -0.06 -0.16 0.1 -0.19 -0.03 0.21 -0.13 0.06 0.01 0 0.07 0.05 -0.08 0.16 -0.33 0.24 -0.12 0.07 0.09 -0.03 -0.13 0.27 -0.07 0.04 -0.06 -0.35 0.07 -0.11 -0.11 -0.21 0.07 -0.09 -0.11 0.27 -0.04 -0.04
# BIC Model FOrecast
bic_fore.short = fore.arima.wge(ts_nly_open, phi = bic_est$phi, theta = bic_est$theta, d=1, n.ahead = 12, lastn = T, limits = T)
## y.arma -0.02 -0.48 0.24 0.17 -0.29 0.21 0.22 -0.04 0.32 0.26 0.14 -0.14 -0.02 0.42 -0.2 0.36 0.09 -0.52 0.09 0.43 -0.19 0.28 0.03 0.05 0.08 0.09 0.02 -0.17 0 0.03 -0.22 -0.37 0.08 0.1 0.08 -0.08 0.19 0.33 0.02 0.12 -0.1 -0.43 -0.04 -0.44 -0.11 0.41 -0.01 0.16 0.04 -0.15 0.16 0.11 0.01 -0.07 -0.03 -0.08 -0.3 -0.06 -0.18 -0.18 -0.07 -0.01 -0.04 0.14 0.08 -0.1 -0.19 0.04 0.27 -0.21 -0.08 -0.06 -0.09 -0.07 -0.13 -0.03 0.08 0.1 0.2 -0.52 -0.01 0.01 -0.67 0.06 0.18 0.28 -0.22 0.4 0.13 0.29 -0.51 0.3 0.03 -0.09 0.27 -0.29 -0.09 0.24 -0.1 0.07 -0.26 -0.48 0.1 -0.02 0.12 -0.19 -0.27 0.31 0.24 -0.44 0.06 -0.41 0.06 0.46 0.22 0.06 0.2 0.23 0.1 -0.01 0.12 0.04 -0.12 -0.17 0.24 -0.17 0.2 0.45 0.15 -0.07 -0.34 0.21 -0.03 -0.2 0.31 0.05 -0.17 -0.14 0.25 0.08 0.11 -0.03 -0.13 -0.13 0.1 -0.49 0.06 0.32 -0.32 -0.42 0.1 -0.04 0.17 0.07 -0.25 -0.07 0.08 -0.13 0.49 -0.25 0.11 -0.31 0.24 -0.11 0.01 0.09 0.06 0.24 0.3 0.23 -0.12 0 0.06 0.12 -0.03 0.19 0.33 0.15 0.06 -0.26 -0.28 0.23 0.28 0.21 0.11 0.26 0.22 -0.56 0.02 0.26 -0.42 0.06 0.04 0.3 0.06 0.01 0.09 -0.07 -0.05 0.12 -0.26 -0.06 0.09 0.02 -0.67 -0.39 0.01 0.29 0.29 0.06 0.12 0.29 -0.2 -0.17 -0.32 -0.26 -0.08 -0.35 -0.56 -0.09 0.38 -0.18 -0.33 0.25 0.27 -0.06 -0.16 0.1 -0.19 -0.03 0.21 -0.13 0.06 0.01 0 0.07 0.05 -0.08 0.16 -0.33 0.24 -0.12 0.07 0.09 -0.03 -0.13 0.27 -0.07 0.04 -0.06 -0.35 0.07 -0.11 -0.11 -0.21 0.07 -0.09 -0.11 0.27 -0.04 -0.04
# Both are more or less the same model given the ARMA component cancel each other out
# AIC Model Forecast
aic_fore.long = fore.arima.wge(ts_nly_open, phi = aic_est$phi, theta = aic_est$theta, d=1,n.ahead = 20, lastn = T, limits = T)
## y.arma -0.02 -0.48 0.24 0.17 -0.29 0.21 0.22 -0.04 0.32 0.26 0.14 -0.14 -0.02 0.42 -0.2 0.36 0.09 -0.52 0.09 0.43 -0.19 0.28 0.03 0.05 0.08 0.09 0.02 -0.17 0 0.03 -0.22 -0.37 0.08 0.1 0.08 -0.08 0.19 0.33 0.02 0.12 -0.1 -0.43 -0.04 -0.44 -0.11 0.41 -0.01 0.16 0.04 -0.15 0.16 0.11 0.01 -0.07 -0.03 -0.08 -0.3 -0.06 -0.18 -0.18 -0.07 -0.01 -0.04 0.14 0.08 -0.1 -0.19 0.04 0.27 -0.21 -0.08 -0.06 -0.09 -0.07 -0.13 -0.03 0.08 0.1 0.2 -0.52 -0.01 0.01 -0.67 0.06 0.18 0.28 -0.22 0.4 0.13 0.29 -0.51 0.3 0.03 -0.09 0.27 -0.29 -0.09 0.24 -0.1 0.07 -0.26 -0.48 0.1 -0.02 0.12 -0.19 -0.27 0.31 0.24 -0.44 0.06 -0.41 0.06 0.46 0.22 0.06 0.2 0.23 0.1 -0.01 0.12 0.04 -0.12 -0.17 0.24 -0.17 0.2 0.45 0.15 -0.07 -0.34 0.21 -0.03 -0.2 0.31 0.05 -0.17 -0.14 0.25 0.08 0.11 -0.03 -0.13 -0.13 0.1 -0.49 0.06 0.32 -0.32 -0.42 0.1 -0.04 0.17 0.07 -0.25 -0.07 0.08 -0.13 0.49 -0.25 0.11 -0.31 0.24 -0.11 0.01 0.09 0.06 0.24 0.3 0.23 -0.12 0 0.06 0.12 -0.03 0.19 0.33 0.15 0.06 -0.26 -0.28 0.23 0.28 0.21 0.11 0.26 0.22 -0.56 0.02 0.26 -0.42 0.06 0.04 0.3 0.06 0.01 0.09 -0.07 -0.05 0.12 -0.26 -0.06 0.09 0.02 -0.67 -0.39 0.01 0.29 0.29 0.06 0.12 0.29 -0.2 -0.17 -0.32 -0.26 -0.08 -0.35 -0.56 -0.09 0.38 -0.18 -0.33 0.25 0.27 -0.06 -0.16 0.1 -0.19 -0.03 0.21 -0.13 0.06 0.01 0 0.07 0.05 -0.08 0.16 -0.33 0.24 -0.12 0.07 0.09 -0.03 -0.13 0.27 -0.07 0.04 -0.06 -0.35 0.07 -0.11 -0.11 -0.21 0.07 -0.09 -0.11 0.27 -0.04 -0.04
# BIC Model FOrecast
bic_fore.long = fore.arima.wge(ts_nly_open, phi = bic_est$phi, theta = bic_est$theta, d=1, n.ahead = 20, lastn = T, limits = T)
## y.arma -0.02 -0.48 0.24 0.17 -0.29 0.21 0.22 -0.04 0.32 0.26 0.14 -0.14 -0.02 0.42 -0.2 0.36 0.09 -0.52 0.09 0.43 -0.19 0.28 0.03 0.05 0.08 0.09 0.02 -0.17 0 0.03 -0.22 -0.37 0.08 0.1 0.08 -0.08 0.19 0.33 0.02 0.12 -0.1 -0.43 -0.04 -0.44 -0.11 0.41 -0.01 0.16 0.04 -0.15 0.16 0.11 0.01 -0.07 -0.03 -0.08 -0.3 -0.06 -0.18 -0.18 -0.07 -0.01 -0.04 0.14 0.08 -0.1 -0.19 0.04 0.27 -0.21 -0.08 -0.06 -0.09 -0.07 -0.13 -0.03 0.08 0.1 0.2 -0.52 -0.01 0.01 -0.67 0.06 0.18 0.28 -0.22 0.4 0.13 0.29 -0.51 0.3 0.03 -0.09 0.27 -0.29 -0.09 0.24 -0.1 0.07 -0.26 -0.48 0.1 -0.02 0.12 -0.19 -0.27 0.31 0.24 -0.44 0.06 -0.41 0.06 0.46 0.22 0.06 0.2 0.23 0.1 -0.01 0.12 0.04 -0.12 -0.17 0.24 -0.17 0.2 0.45 0.15 -0.07 -0.34 0.21 -0.03 -0.2 0.31 0.05 -0.17 -0.14 0.25 0.08 0.11 -0.03 -0.13 -0.13 0.1 -0.49 0.06 0.32 -0.32 -0.42 0.1 -0.04 0.17 0.07 -0.25 -0.07 0.08 -0.13 0.49 -0.25 0.11 -0.31 0.24 -0.11 0.01 0.09 0.06 0.24 0.3 0.23 -0.12 0 0.06 0.12 -0.03 0.19 0.33 0.15 0.06 -0.26 -0.28 0.23 0.28 0.21 0.11 0.26 0.22 -0.56 0.02 0.26 -0.42 0.06 0.04 0.3 0.06 0.01 0.09 -0.07 -0.05 0.12 -0.26 -0.06 0.09 0.02 -0.67 -0.39 0.01 0.29 0.29 0.06 0.12 0.29 -0.2 -0.17 -0.32 -0.26 -0.08 -0.35 -0.56 -0.09 0.38 -0.18 -0.33 0.25 0.27 -0.06 -0.16 0.1 -0.19 -0.03 0.21 -0.13 0.06 0.01 0 0.07 0.05 -0.08 0.16 -0.33 0.24 -0.12 0.07 0.09 -0.03 -0.13 0.27 -0.07 0.04 -0.06 -0.35 0.07 -0.11 -0.11 -0.21 0.07 -0.09 -0.11 0.27 -0.04 -0.04
# Fit the VAR model using the lagged_data Short
plot(data$Open, type = "l", main = "Forecast of VAR Model Short Horizon Market Open Price at lag 1")
lines(seq(251,262,1),pred.short$fcst$Open[,1],col = "red")
plot(data$Open, type = "l", main = "Forecast of VAR Model Long Horizon Market Open Price at lag 1")
lines(seq(243,262,1),pred.long$fcst$Open[,1],col = "red")
# Forecast the MLP model Short
plot(df.adj$Open, type = "l", main = "Forecast of MLP Model Short Horizon Market Open Price at lag 1")
lines(seq(251,262,1),fore.mlp.short$mean,col = "blue")
plot(df.adj$Open, type = "l", main = "Forecast of MLP Model Long Horizon Market Open Price at lag 1")
lines(seq(243,262,1),fore.mlp.long$mean,col = "blue")
# Forecast the Ensemble Models
plot(df.adj$Open, type = "l", main = "Forecast of Ensemble Short Horizon Model for Market Open Price at lag 1")
lines(seq(251,262,1),sh_ensemble,col = "green")
plot(df.adj$Open, type = "l", main = "Forecast of Ensemble Long Horizon Model for Market Open Price at lag 1")
lines(seq(243,262,1),lh_ensemble,col = "green")
Comment here on the factor, the strong behavior is indicating that